home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / surfsrc3.zip / SURFBGI.PAS < prev    next >
Pascal/Delphi Source File  |  1991-09-29  |  18KB  |  675 lines
  1. {$I defines.inc}
  2. {*********************************************************}
  3. {                                                         }
  4. {       Extensions to the                                 }
  5. {       Turbo Pascal Versions 4.0 - 6.0                   }
  6. {       GRAPH Unit Interface                              }
  7. {                                                         }
  8. {*********************************************************}
  9.  
  10. { Version 1.00a,  Date 30 Jan 1988, Author: Kevin Lowey                    }
  11.  
  12. { This unit should be included AFTER the GRAPHICS unit in your program.  It}
  13. { it implements the BGI routines for unsupported devices.  The difference  }
  14. { is these routines are always resident, instead of in a file on the disk  }
  15. { so they eat up memory.                                                   }
  16.  
  17. { In addition to this file, you will also have to change DEFINES.INC.      }
  18. { You must create a DEFINE statement which describes your device, so people}
  19. { can turn off or on the device when they compile surfmodl.                }
  20.  
  21. { To use this system, include the routines for your graphics device into   }
  22. { the case statement in each  procedure, with an IFDEF and ENDIF around it }
  23. { so people can turn off the device.  The important routines are the ones  }
  24. { to select the driver (initgraph and detectgraph), the ones to leave graph}
  25. { mode (restorecrtmode and closegraph), and the one to draw a point on the }
  26. { screen (putpixel).  Other routines such as putimage and getimage can be  }
  27. { replaced by dummy routines that do nothing.  This will get rid of some   }
  28. { functions, but the basic SURFMODL program will still work.               }
  29. {                                                                          }
  30. { See the Turbo Pascal manual (or the online help) for a description of    }
  31. { each procedure.                                                          }
  32.  
  33. { You will also have to change the definitions in the SURFGRAF unit.  This }
  34. { unit contains all the SURFMODL graphics primitives.  You will have to    }
  35. { change MAXSYS, and add your device to the list of supported devices.     }
  36. { See the VAXMATE example below and in SURFBGI for more details            }
  37.  
  38. { I give an example using the DEC VAXMATE computer.  This computer provides}
  39. { the standard CGA graphics modes, plus a 640x400x2 graphics mode which is }
  40. { almost compatible with the AT&T 640x400x2 graphics mode.  The only       }
  41. { difference is the interrupt $10 function used to enter graphics mode.    }
  42. { The memory map, etc. is the same.  I cheated in implementing the graphics}
  43. { by having the program use the AT&T .BGI driver, and give the VAXMATE     }
  44. { interrupt immediately after using INITGRAPH or SETGRAPHMODE.  The program}
  45. { thinks it is using an AT&T, so all the graphics funtions are available.  }
  46. { You may wish to use a similar trick with your driver.                    }
  47. {                                                                          }
  48. { NOTE, the vaxmate driver works as is, but should not have to be used.    }
  49. { the surfmodl disk includes a TSR program called EMULATT which makes a    }
  50. { vaxmate think it is an AT&T computer.  Once EMULATT is loaded, you can   }
  51. { choose the AT&T option from the menu and the graphics routines will work }
  52. { on the vaxmate.  I left the routines in here just for demonstration use  }
  53.  
  54. { You will also have to modify the SURFGRAF unit to include your device in }
  55. { the menu of options available.                                           }
  56.  
  57. Unit SURFBGI;  { Surfmodl BGI emulation and true BGI routines }
  58.  
  59. interface
  60. uses
  61.     DOS, GRAPH, CRT,
  62.     SHAREDEC;
  63.  
  64. {$IFDEF USE8087}
  65. TYPE REAL = single;
  66. {$ENDIF}
  67.  
  68. const
  69.   {Redo Turbo Pascal constants}
  70.   NOTput  = 4;
  71.   NormalPut = 0;
  72.  
  73.   GRok = 0;
  74.   GRerror = -11;
  75.  
  76.   DETECT = 0;
  77.   CGA = 1;
  78.   MCGA = 2;
  79.   EGA = 3;
  80.   EGA64 = 4;
  81.   EGAMONO = 5;
  82.   IBM8514 = 6;
  83.   VGA256 = 6;
  84.   HERCMONO = 7;
  85.   ATT400 = 8;
  86.   VGA = 9;
  87.   PC3270 = 10;
  88.  
  89.   { add your own constant here for your machine, such as SANYO = 12  }
  90.  
  91. {$IFDEF VAXMATE} {should never need to define, see notes above}
  92.   VM400 = 11;  {Vaxmate constant}
  93.   { Also add constants for all the modes available, starting at 0.   }
  94.   { See the Graph Unit description in the Turbo Pascal manual or in  }
  95.   { the online help for examples }
  96.  
  97.   { Vaxmate CGA compatible modes }
  98.   VM400C0   = CGAC0; { 320x200 palette 0: LightGreen, LightRed, Yellow; 1 page }
  99.   VM400C1   = CGAC1; { 320x200 palette 1: LightCyan, LightMagenta, White; 1 page }
  100.   VM400C2   = CGAC2; { 320x200 palette 2: Green, Red, Brown; 1 page }
  101.   VM400C3   = CGAC3; { 320x200 palette 3: Cyan, Magenta, LightGray; 1 page }
  102.   VM400Med  = 4;  { 640x200 1 page }
  103.  
  104.   { Vaxmate high resolution modes }
  105.   VM400HiCo = 5;  { 640x400 4 color 1 page }
  106.   VM400Hi   = 6;  { 640x400 1 color 1 page }
  107. {$ENDIF}
  108.  
  109. {$IFDEF USE_IFF}
  110.   IFF      = 11;
  111.  
  112.   IFFC0     = 0;  { 320x200, 32 colors auto-selected from 4096-color palette }
  113. {$ENDIF}
  114.  
  115.  
  116. {  detection, initialization and crt mode routines }
  117. {  see the Turbo Pascal manual for details on what the routines must do }
  118.  
  119. procedure DetectGraph(var GraphDriver, GraphMode : integer);
  120. procedure InitGraph(var GraphDriver : integer;
  121.                     var GraphMode   : integer;
  122.                         PathToDriver : String);
  123. procedure GetModeRange(GraphDriver : integer; var LoMode, HiMode : integer);
  124. procedure SetGraphMode(Mode : integer);
  125. procedure settextjustify (Horiz, Vert : word);
  126. function getmaxcolor:word;
  127. procedure RestoreCrtMode;
  128. procedure closegraph;
  129. procedure outtextxy (x,y :integer; textline:string);
  130. function  GetMaxX : integer;
  131. function  GetMaxY : integer;
  132. procedure PutPixel(X, Y : integer; Pixel : word);
  133. function graphresult : integer;
  134. procedure GetImage(x1, y1, x2, y2 : integer;
  135.                    var BitMap);
  136. procedure PutImage(X, Y : integer; var
  137.           BitMap; BitBlt : word);
  138. function ImageSize(x1, y1, x2, y2 : integer) : word;
  139. function GraphErrorMsg(ErrorCode : integer) : string;
  140. Procedure Setcolor(color:word);
  141. function TextWidth(str: string): word;
  142. function TextHeight(str: string): word;
  143. procedure ClearDevice;
  144.  
  145. {$ifdef USE_IFF}
  146. procedure MEMSET (dat: pointer; val, len: word);
  147. procedure INITIFF;
  148. procedure EXITIFF;
  149. procedure IFFPLOT (X, Y, Color: integer);
  150. procedure SWAP_BYTES (dat: pointer; len: word);
  151. procedure GET1ROW (y, plane: integer; var row: RowArray; var nbytes: integer);
  152. procedure WRITE_BODY (var out: file; var tot_len: longint);
  153. procedure SAVEIFF (Filename: string; var Pal: SurfPalette);
  154. {$endif}
  155.  
  156.  
  157. IMPLEMENTATION
  158.  
  159. const
  160.   { used in detect graph }
  161.   CASSETTE_IO     = $15;
  162.   DEC_CONF_WORD   = $D0;
  163.  
  164.  
  165.   {Used in setting video mode}
  166.   VIDEO_SERVICES  = $10;
  167.   DEC_HIRES       = $D0;
  168.   DEC_HIRES_COLOR = $D1;
  169.   SET_VIDEO_MODE  = $00;
  170.   write_pixel     = $0C;
  171.  
  172.   {Dummy used in CASE statements to achieve device independance}
  173.   dummy = maxint;
  174.  
  175. var
  176.   regs : registers;
  177.   grdriver : integer;
  178.   GetGraphMode : integer;
  179.   GraphError : integer;
  180.   grmaxx  : integer;
  181.   grmaxy  : integer;
  182.  
  183. {$ifdef USE_IFF}
  184. {$I IFF.INC}
  185. {$endif}
  186.  
  187. function GraphErrorMsg(ErrorCode : integer) : string;
  188. begin
  189. {$IFDEF USE_IFF}
  190.   if grdriver = IFF then begin
  191.     if ErrorCode = 0 then
  192.       GraphErrorMsg := 'No error'
  193.     else
  194.       GraphErrorMsg := 'Unknown IFF Error';
  195.   end else
  196. {$ENDIF}
  197.   GraphErrorMsg := graph.grapherrormsg(errorcode);
  198. end;
  199.  
  200.  
  201. Procedure Setcolor(color:word);
  202. begin
  203. {$IFDEF USE_IFF}
  204.   if grdriver <> IFF then
  205. {$ENDIF}
  206.     graph.setcolor(color);
  207. end;
  208.  
  209.  
  210. procedure outtextxy (x,y :integer; textline:string);
  211. begin
  212.   case grdriver of
  213.     dummy : ;
  214. {$IFDEF VAXMATE}
  215.     vm400 : if getgraphmode <> VM400HICO then
  216.                graph.outtextxy (x,y,textline);
  217. {$ENDIF}
  218. {$IFDEF USE_IFF}
  219.     IFF : ;   { text not supported on Amiga }
  220. {$ENDIF}
  221.     else
  222.      graph.outtextxy (x,y,textline);
  223.   end; {case}
  224. end;
  225.  
  226.  
  227.  
  228. function getmaxcolor:word;
  229. begin
  230.   case grdriver of
  231.     dummy : ;
  232. {$IFDEF VAXMATE}
  233.     VM400 : begin
  234.               if (getgraphmode in [VM400c0..VM400MED,VM400HI]) then
  235.                 getmaxcolor := graph.getmaxcolor
  236.               else if getgraphmode = VM400HICO then
  237.                 getmaxcolor := 3;
  238.             end; {Vaxmate }
  239. {$ENDIF}
  240. {$IFDEF USE_IFF}
  241.     IFF : begin
  242.       { Currently only one mode supported }
  243.       getmaxcolor := 32;
  244.     end;
  245. {$ENDIF}
  246.     else begin
  247.       getmaxcolor := graph.getmaxcolor;
  248.     end;
  249.   end; {case}
  250. end; { getmaxcolor}
  251.  
  252.  
  253.  
  254. procedure PutPixel(X, Y : integer; pixel : word);
  255. begin
  256.   case GRdriver of
  257.     dummy : ;
  258. {$ifdef VAXMATE}
  259.     VM400 : begin  { Use DOS bios calls to write a pixel }
  260.               with regs do begin
  261.                 ah := write_pixel;
  262.                 al := pixel;
  263.                 cx := x;
  264.                 dx := y;
  265.               end; {with}
  266.               intr (video_services,regs);
  267.             end;
  268. {$ENDIF}
  269. {$IFDEF USE_IFF}
  270.     IFF :          { Write pixel to internal screen buffer }
  271.       iffplot (x,y,pixel);
  272. {$ENDIF}
  273.     else begin {BGI}
  274.       graph.putpixel (x,y,pixel);
  275.     end; {else}
  276.   end; {case}
  277. end; {putpixel}
  278.  
  279.  
  280.  
  281. {$IFDEF VAXMATE}
  282. procedure DOS_SET_MODE (MODE:BYTE);
  283. begin
  284.   {DEC specific modes}
  285.   with regs do begin
  286.     ah := Set_Video_Mode;
  287.     al := mode;
  288.   end;
  289.    intr (Video_services,regs);
  290. end; {Dos_Set_Mode}
  291. {$ENDIF}
  292.  
  293.  
  294. procedure restorecrtmode;
  295. begin
  296.   case grdriver of
  297.     Dummy : ;
  298. {$IFDEF USE_IFF}
  299.     IFF :
  300.       exitiff;
  301. {$ENDIF}
  302.     else begin
  303.        graph.restorecrtmode;
  304.     end;
  305.   end;
  306. end; {restorecrtmode}
  307.  
  308.  
  309.  
  310. procedure closegraph;
  311. var i: integer;
  312. begin
  313.   case grdriver of
  314.     dummy : ;
  315. {$IFDEF USE_IFF}
  316.     IFF :
  317.       GraphError := 0;
  318. {$ENDIF}
  319.     else begin
  320.       graph.closegraph;
  321.       GraphError := graph.graphresult;
  322.       grdriver := 0;
  323.     end; {else}
  324.   end; {case}
  325. end; {closegraph}
  326.  
  327.  
  328. function  GetMaxX : integer;
  329. begin
  330.   case grdriver of
  331.     dummy : ;
  332.  
  333. {$IFDEF VAXMATE}
  334.     VM400 : begin
  335.               if getgraphmode in [vm400c0 .. VM400C3] then
  336.                 getmaxx := 319
  337.               else
  338.                 getmaxx := 639;
  339.             end;
  340. {$ENDIF}
  341. {$IFDEF USE_IFF}
  342.     IFF : begin
  343.       getmaxx := 319;
  344.     end;
  345. {$ENDIF}
  346.  
  347.     else begin
  348.       getmaxx := graph.getmaxx;
  349.     end;
  350.   end; {case}
  351. end; {getMaxX}
  352.  
  353.  
  354.  
  355. function  GetMaxY : integer;
  356. begin
  357.   case grdriver of
  358.     dummy :;
  359.  
  360. {$IFDEF VAXMATE}
  361.     VM400 : begin
  362.               if getgraphmode in [vm400c0 .. VM400MED] then
  363.                 getmaxy := 199
  364.               else
  365.                 getmaxy := 399;
  366.             end;
  367. {$ENDIF}
  368. {$IFDEF USE_IFF}
  369.     IFF : begin
  370.       getmaxy := 199;
  371.     end;
  372. {$ENDIF}
  373.  
  374.     else begin
  375.       getmaxy := graph.getmaxy;
  376.     end;
  377.   end; {case}
  378. end; {getMaxy}
  379.  
  380.  
  381. function graphresult : integer;
  382. { my definition of graphresult so my routines can return proper values }
  383. begin
  384.     if (GraphError < -15) or (GraphError > 0) then
  385.       GraphError := 0;
  386.  
  387.   graphresult := GraphError;
  388.   GraphError := 0;
  389. end;
  390.  
  391.  
  392.  
  393. { *** detection, initialization and crt mode routines *** }
  394.  
  395. procedure DetectGraph(var GraphDriver, GraphMode : integer);
  396.  
  397. { this procedure must detect what machine you are on.  Some machines  }
  398. { include routines for this, while others you may have to look at the }
  399. { copyright message for the bios.                                     }
  400.  
  401. begin
  402.   graphdriver :=  0;
  403.   graphmode   :=  0;
  404.  
  405. {$IFNDEF USE_IFF}
  406.   graph.detectgraph(graphdriver,graphmode);
  407. {$ENDIF}
  408.  
  409. {$IFDEF VAXMATE}  {This doesn't work right.  Some non-vaxmates are reported}
  410.   if graphdriver = RESERVED then begin
  411.     {check if vaxmate}
  412.     regs.ah := DEC_CONF_WORD;
  413.     intr(CASSETTE_IO,regs);
  414.  
  415.     if (regs.AH = $86) then begin  {Vaxmate Detected}
  416.       if (regs.BX and $00E0) = $0040 then begin {vaxmate graphics system}
  417.         graphdriver := VM400;
  418.         GraphMode   := VM400HI;
  419.       end
  420.     end { If machine vaxmate }
  421.   end; {if RESERVED perhaps vaxmate}
  422. {$ENDIF}
  423.  
  424.   grdriver := graphdriver;
  425.   getGraphMode := graphmode;
  426. {$IFDEF USE_IFF}
  427.   GraphError := 0;
  428. {$ELSE}
  429.   GraphError := graph.graphresult;
  430. {$ENDIF}
  431. end; {Detectgraph}
  432.  
  433.  
  434. procedure SetGraphMode(Mode : integer);
  435. {Routine to enter graphics mode}
  436. begin
  437.  
  438.   case grdriver of
  439.     dummy :;
  440.  
  441. {$IFDEF VAXMATE}
  442. {Uses the AT&T graph mode so Turbo's .BGI routines work correct,      }
  443. { then calls its own interrupt to go into graphics mode on the VAXmate}
  444.     VM400 : begin
  445.               if mode in [VM400C0..VM400MED] then begin
  446.                 graph.setgraphmode (mode);
  447.                 GraphError := graph.graphresult;
  448.               end {CGA compatible modes}
  449.               ELSE if mode = VM400HI then begin
  450.                   graph.setgraphmode (ATT400HI);
  451.                   GraphError := graph.graphresult;
  452.                   dos_set_mode (DEC_Hires)
  453.               end
  454.               else if mode = VM400HICO then begin
  455.                   graph.setgraphmode (att400hi);
  456.                   grapherror := graph.graphresult;
  457.                   dos_set_mode (DEC_HIRES_COLOR)
  458.               end
  459.               else
  460.                 GraphError := grInvalidMode;
  461.             end; {Vaxmate mode}
  462. {$ENDIF}
  463. {$IFDEF USE_IFF}
  464.     IFF : begin
  465.       GraphError := 0;
  466.       initiff;
  467.     end;
  468. {$ENDIF}
  469.  
  470.     else Begin {Not DEC compatible mode}
  471.       graph.setgraphmode (mode);
  472.       GraphError := graph.graphresult;
  473.     end;
  474.  
  475.   end; {case}
  476. end; {setgraphmode}
  477.  
  478.  
  479.  
  480. procedure InitGraph(var GraphDriver : integer;
  481.                     var GraphMode   : integer;
  482.                         PathToDriver : String);
  483. var
  484.   temp1,temp2 : integer;
  485.   i: integer;
  486.   Mat: integer;
  487.  
  488. begin
  489.   if graphdriver = 0 then
  490.     detectgraph (graphdriver,graphmode);
  491.  
  492.   grdriver := GraphDriver;
  493.   getGraphMODE := GraphMode;
  494.  
  495.   case graphdriver of
  496.     dummy :;
  497.     { usually nothing is needed here because the "drivers" are already }
  498.     { "loaded" into memory for our own devices. }
  499. {$IFDEF VAXMATE}
  500.     VM400: begin
  501.              temp1 := ATT400;
  502.              if graphmode > VM400MED then
  503.                temp2 := ATT400HI
  504.              else
  505.                temp2 := graphmode;
  506.              graph.initgraph (temp1,temp2,pathtodriver);
  507.              GraphError := graph.graphresult;
  508.              if GraphError > grok then
  509.                setgraphmode (getgraphmode);
  510.            end;
  511. {$ENDIF}
  512. {$IFDEF USE_IFF}
  513.     IFF :
  514.       GraphError := 0;
  515. {$ENDIF}
  516.     else begin {not extended BGI }
  517.       graph.initgraph (graphdriver, graphmode, pathtodriver);
  518.       GraphError := graph.graphresult;
  519.       grdriver := graphmode;
  520.     end; {else}
  521.   end; { Case }
  522.  
  523. end; { initgraph }
  524.  
  525.  
  526.  
  527. procedure GetModeRange(GraphDriver : integer; var LoMode, HiMode : integer);
  528. begin
  529.   case graphdriver of
  530.     dummy : ;
  531.  
  532. {$IFDEF VAXMATE}
  533.     VM400 : begin
  534.               lomode := VM400C0;
  535.               HiMode := VM400HI;
  536.             end;
  537. {$ENDIF}
  538. {$IFDEF USE_IFF}
  539.     IFF : begin
  540.       lomode := IFFC0;
  541.       HiMode := IFFC0;
  542.     end;
  543. {$ENDIF}
  544.  
  545.     ELSE begin { Not an extended mode }
  546.       graph.getmoderange(graphdriver,lomode,himode);
  547.       GraphError := graph.graphresult;
  548.     end; {Not an extended mode}
  549.   end; {Case}
  550. end; {GetModeRange}
  551.  
  552.  
  553.  
  554. procedure settextjustify (Horiz, Vert : word);
  555. begin
  556.   case grdriver of
  557.     dummy : ;
  558. {$IFDEF USE_IFF}
  559.     IFF : ;
  560. {$ENDIF}
  561.     {The vaxmate version has not been implemented for 640x400x4 mode, but  }
  562.     {the 640x400x2 mode works properlly when emulating an AT&T computer    }
  563.     else begin {normal BGI routines}
  564.       graph.settextjustify (horiz, vert);
  565.       GraphError := graph.graphresult;
  566.     end;
  567.   end; {case}
  568. end; {settextjustify}
  569.  
  570.  
  571.  
  572. procedure GetImage(x1, y1, x2, y2 : integer;
  573.                    var BitMap);
  574. BEGIN
  575.   Case grdriver of
  576.  
  577.     dummy : ; {dummy position}
  578.  
  579. {$IFDEF VAXMATE}
  580.     { AT&T getimage works for all modes but 640x400x4}
  581.     VM400 : begin {Digital Vaxmate}
  582.               if getgraphmode <> VM400HICO then
  583.                 graph.getimage(x1,y1,x2,y2,bitmap)
  584.               else
  585.                 GraphError := grerror;
  586.             end;
  587. {$ENDIF}
  588. {$IFDEF USE_IFF}
  589.     IFF : ;
  590. {$ENDIF}
  591.     else  graph.getimage (x1,y1,x2,y2,bitmap); {Normal BGI driver}
  592.   end; {Case}
  593. end; {getimage}
  594.  
  595.  
  596.  
  597. procedure PutImage(X, Y : integer; var
  598.           BitMap; BitBlt : word);
  599. begin
  600.   Case grdriver of
  601.     dummy : ; {dummy position}
  602.  
  603. {$IFDEF VAXMATE}
  604.     { AT&T driver works for all modes but 640x400x4}
  605.     VM400 : begin {Digital Vaxmate}
  606.               if getgraphmode <> VM400HICO then
  607.                 graph.putimage (x,y,bitmap,bitblt)
  608.               else
  609.                 grapherror := grerror;
  610.             end;
  611. {$ENDIF}
  612. {$IFDEF USE_IFF}
  613.     IFF : ;
  614. {$ENDIF}
  615.  
  616.     else  graph.putimage (x,y,bitmap,bitblt); {Normal BGI driver}
  617.   end; {Case}
  618. end; {Imagesize}
  619.  
  620.  
  621.  
  622. function ImageSize(x1, y1, x2, y2 : integer) : word;
  623. begin
  624.   Case grdriver of
  625.  
  626.     dummy : ; {dummy position}
  627.  
  628. {$IFDEF VAXMATE}
  629.     {AT&T driver works for all modes but 640x400x4}
  630.     VM400 : begin {Digital Vaxmate}
  631.               if getgraphmode <> VM400HICO then
  632.                 imagesize := graph.ImageSize (x1,y1,x2,y2)
  633.               else
  634.                 imagesize := 0;
  635.             end; { Digital Vaxmate }
  636. {$ENDIF}
  637. {$IFDEF USE_IFF}
  638.     IFF :
  639.       imagesize := 0;
  640. {$ENDIF}
  641.  
  642.     else begin  { Normal BGI driver }
  643.       imagesize := graph.ImageSize (x1,y1,x2,y2); {Normal BGI driver}
  644.     end;
  645.   end; {Case}
  646. end; {imagesize}
  647.  
  648.  
  649. function TextWidth(str: string): word;
  650. begin
  651.   TextWidth := length(str) * 8;
  652. end;
  653.  
  654. function TextHeight(str: string): word;
  655. begin
  656.   TextHeight := 8;
  657. end;
  658.  
  659.  
  660. procedure ClearDevice;
  661. begin
  662.   restorecrtmode;
  663.   setgraphmode (getgraphmode);
  664. end;
  665.  
  666.  
  667. { Following is the SURFBGI initiator function: }
  668. begin
  669.   GraphError := 0;
  670.   grdriver := 0;
  671.   getgraphmode := 0;
  672.   grmaxx := 0;
  673.   grmaxy := 0;
  674. end.
  675.